ValidationRule and ValidationText Properties Example
This example creates a new Field object in the specified TableDef object and sets the ValidationRule and ValidationText properties based on the passed data. It also shows how the ValidationRule and ValidationText properties are used during actual data entry. The SetValidation function is required for this procedure to run.
Sub ValidationRuleX()
Dim dbsNorthwind As Database
Dim fldDays As Field
Dim rstEmployees As Recordset
Dim strMessage As String
Dim strDays As String
Dim errLoop As Error
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
' Create a new field for the Employees TableDef object
' using the specified property settings.
Set fldDays = _
SetValidation(dbsNorthwind.TableDefs!Employees, _
"DaysOfVacation", dbInteger, 2, "BETWEEN 1 AND 20", _
"Number must be between 1 and 20!")
Set rstEmployees = _
dbsNorthwind.OpenRecordset("Employees")
With rstEmployees
' Enumerate Recordset. With each record, fill the new
' field with data supplied by the user.
Do While Not .EOF
.Edit
strMessage = "Enter days of vacation for " & _
!FirstName & " " & !LastName & vbCr & _
"[" & !DaysOfVacation.ValidationRule & "]"
Do While True
' Get user input.
strDays = InputBox(strMessage)
If strDays = "" Then
.CancelUpdate
Exit Do
End If
!DaysOfVacation = Val(strDays)
' Because ValidateOnSet defaults to False, the
' data in the buffer will be checked against the
' ValidationRule during Update.
On Error GoTo Err_Rule
.Update
On Error GoTo 0
' If the Update method was successful, print the
' results of the data change.
If .EditMode = dbEditNone Then
Debug.Print !FirstName & " " & !LastName & _
" - " & "DaysOfVacation = " & _
!DaysOfVacation
Exit Do
End If
Loop
If strDays = "" Then Exit Do
.MoveNext
Loop
.Close
End With
' Delete new field because this is a demonstration.
dbsNorthwind.TableDefs!Employees.Fields.Delete _
fldDays.Name
dbsNorthwind.Close
Exit Sub
Err_Rule:
If DBEngine.Errors.Count > 0 Then
' Enumerate the Errors collection.
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & _
errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End If
Resume Next
End Sub
Function SetValidation(tdfTemp As TableDef, _
strFieldName As String, intType As Integer, _
intLength As Integer, strRule As String, _
strText As String) As Field
' Create and append a new Field object to the Fields
' collection of the specified TableDef object.
Set SetValidation = tdfTemp.CreateField(strFieldName, _
intType, intLength)
SetValidation.ValidationRule = strRule
SetValidation.ValidationText = strText
tdfTemp.Fields.Append SetValidation
End Function